{This file is part of CheLive.

CheLive is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Foobar is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Foobar.  If not, see <http://www.gnu.org/licenses/>.}

{Модуль реализует работу с текстурными шрифтами}
unit CoreFont;

interface

uses
	SysUtils,
{$IFDEF WIN32}
	Windows,
{$ENDIF}
{$IFDEF LINUX}
	x, xlib, xrender, Xft,
{$ENDIF}
	gl, glext, CoreTypes, CoreMath, CoreTexture;

const
	{Жирный}
	FONT_B = 1;
	{Курсив}
	FONT_I = 2;
	
	{Символи из набора ANSI}
	FONT_ANSI = 1;
	{Стандартные кирилические символы}
	FONT_CYR = 2;

type
	PFontSym = ^TFontSym;
	TFontSym = record
		x, y, w, h: Single;
		advance, a, c: Integer;
		coords: array[0..1] of TVec2;
	end;
	
	TFontInt = record
		first, last: Integer;
		syms: array of TFontSym;
	end;
	
	TFontInts = object
		ints: array of TFontInt;
		
		procedure Add(first, last: Integer); overload;
		procedure Add(mask: Integer); overload;
	end;

	TFont = class(TListItem)
		fileName: String;
		tex: TTexture;
		ints: TFontInts;
		height, logHeight, lineSkip: Integer;
		spacing, scale: Single;

		function Gen(height_, style: Integer; faceWindows, faceLinux: String; texW, texH, texFilter: Integer; extraSpacingX: Integer = 0; extraSpacingY: Integer = 0): Boolean; overload;
		function Save(fileName_: String): Boolean;
		function Load(fileName_: String; texFilter: Integer = TEX_BI): Boolean;
		procedure Render(text: String; x, y: Single; c: TVec4);
		function Width(text: String): Single;

		destructor Destroy; override;
	end;

implementation

uses
	CoreConsole, CoreDisplay, CoreWindow;

procedure TFontInts.Add(first, last: Integer);
var
	i: Integer;
begin
	i := Length(ints);
	
	SetLength(ints, i + 1);
	
	ints[i].first := first;
	ints[i].last := last;
end;

procedure TFontInts.Add(mask: Integer);
begin
	if mask and FONT_ANSI <> 0 then Add(0, $7F);
	if mask and FONT_CYR <> 0 then Add($400, $45F);
end;

destructor TFont.Destroy;
begin
	FreeAndNil(tex);
end;

function TFont.Gen(height_, style: Integer; faceWindows, faceLinux: String; texW, texH, texFilter: Integer; extraSpacingX: Integer = 0; extraSpacingY: Integer = 0): Boolean;
var
{$IFDEF WIN32}
	font, dc, bitmap, weight: Cardinal;
	c: WideChar;
	tm: TTextMetric;
	widths: array of TABC;
	gm: TGlyphMetrics;
	mat: TMat2;
	rect: Windows.TRect;
	info: TBitmapInfo;
	bitmapData: TBytes;
{$ENDIF}
{$IFDEF LINUX}
	font: PXftFont;
	gi: TXGlyphInfo;
	cWhite: TXftColor;
	cBlack: TXftColor;
	rWhite: TXRenderColor = (red: $FFFF; green: $FFFF; blue: $FFFF; alpha: $FFFF);
	rBlack: TXRenderColor = (red: $0000; green: $0000; blue: $0000; alpha: $FFFF);
	pixmap: TPixmap;
	draw: PXftDraw;
	image: PXImage;
	color, r, g, b: Cardinal;
{$ENDIF}
	x, y, i, j, k: Integer;
	s: PFontSym;
	data: TTextureData;
begin
	Result := False;
	
	if Length(ints.ints) = 0 then
	begin
		con.Msg('#Не задан ни один интервал символов для шрифта "%s/%s %d"', [faceWindows, faceLinux, height_]);
		Exit;
	end;
	
	SetLength(data.data, texW * texH);
	
	data.w := texW;
	data.h := texH;
	data.format := TEX_ALPHA;

{$IFDEF WIN32}
	if style and FONT_B <> 0 then weight := FW_BOLD else weight := FW_NORMAL;

	font := CreateFont(-MulDiv(height_, GetDeviceCaps(wnd.dc, LOGPIXELSY), 72), 
		0, 0, 0, weight, style and FONT_I, 0, 0, DEFAULT_CHARSET,
		OUT_TT_ONLY_PRECIS, 0, ANTIALIASED_QUALITY, 0, PChar(faceWindows));
	
	if font = 0 then
	begin
		con.Msg('#Не удается сгенерировать шрифт "%s/%s %d"', [faceWindows, faceLinux, height_]);
		Exit;
	end;

	dc := CreateCompatibleDC(0);
	bitmap := CreateCompatibleBitmap(dc, texW, texH);

	SelectObject(dc, bitmap);
	SetRect(rect, 0, 0, texW, texH);
	FillRect(dc, rect, GetStockObject(BLACK_BRUSH));

	SelectObject(dc, font);
	SetBkMode(dc, TRANSPARENT);
	SetTextColor(dc, $FFFFFF);
	
	GetTextMetrics(dc, tm);
	
	logHeight := tm.tmHeight;
	
	FillChar(gm, SizeOf(gm), 0);
	FillChar(mat, SizeOf(mat), 0);
	
	mat.eM11.value := 1;
	mat.eM22.value := 1;
	
	x := extraSpacingX;
	y := extraSpacingY;
	
	for i := 0 to High(ints.ints) do
	begin
		with ints.ints[i] do
		begin
			SetLength(syms, last - first + 1);
			FillChar(syms[0], SizeOf(syms), 0);
			
			SetLength(widths, last - first + 1);
			GetCharABCWidthsW(dc, first, last, widths[0]);
			
			for j := first to last do
			begin
				if (x + tm.tmMaxCharWidth + extraSpacingX) > texW then
				begin
					x := extraSpacingX;
					y += logHeight + extraSpacingY * 2;
				end;
				
				c := WideChar(j);
				k := j - first;
				s := @syms[k];

				TextOutW(dc, x, y, @c, 1);
				GetGlyphOutlineW(dc, j, GGO_METRICS, gm, 0, nil, mat);

				s^.advance := widths[k].abcA + widths[k].abcB + widths[k].abcC;

				if widths[k].abcA < 0 then begin
					s^.advance -= widths[k].abcA;
					s^.a := Abs(widths[k].abcA);
				end;

				if widths[k].abcC < 0 then
				begin
					s^.advance -= widths[k].abcC;
					s^.c := Abs(widths[k].abcC);
				end;
				
				s^.x := -extraSpacingX;
				s^.y := -extraSpacingY;
				s^.w := s^.advance + extraSpacingX * 2;
				s^.h := logHeight + extraSpacingY * 2;

				s^.coords[0].x := (x + s^.x) / texW;
				s^.coords[0].y := (y + s^.y) / texH;
				s^.coords[1].x := (x + s^.x + s^.w) / texW;
				s^.coords[1].y := (y + s^.y + s^.h) / texH;

				x += s^.advance + extraSpacingX * 2;
			end;
		end;
	end;

	FillChar(info, SizeOf(info), 0);

	with info.bmiHeader do
	begin
		biSize := SizeOf(TBitmapInfoHeader);
		biWidth := texW;
		biHeight := texH;
		biPlanes := 1;
		biBitCount := 24;
		biSizeImage := biWidth * biHeight * 3;
	end;

	SetLength(bitmapData, texW * texH * 3);
	GetDIBits(dc, bitmap, 0, texH, @bitmapData[0], info, DIB_RGB_COLORS);
	
	DeleteObject(bitmap);
	DeleteDC(dc);
	DeleteDC(font);

	for i := 0 to texW * texH - 1 do
	begin
		data.data[i] := bitmapData[i * 3];
	end;

	TextureFlipV(@data);
{$ENDIF}
{$IFDEF LINUX}
	font := XftFontOpenName(disp.disp, DefaultScreen(disp.disp), Format('%s-%d', [faceLinux, height_]));
	
	if font = nil then
	begin
		con.Msg('#Не удается сгенерировать шрифт "%s/%s %d"', [faceWindows, faceLinux, height_]);
		Exit;
	end;
	
	logHeight := font^.height;
	
	x := extraSpacingX;
	y := extraSpacingY;
	
	pixmap := XCreatePixmap(disp.disp, DefaultRootWindow(disp.disp), texW, texH, DefaultDepth(disp.disp, DefaultScreen(disp.disp)));
	draw := XftDrawCreate(disp.disp, pixmap, wnd.vi^.visual, DefaultColormap(disp.disp, DefaultRootWindow(disp.disp)));
	
	XftColorAllocValue(disp.disp, wnd.vi^.visual, DefaultColormap(disp.disp, DefaultScreen(disp.disp)), @rWhite, @cWhite);
	XftColorAllocValue(disp.disp, wnd.vi^.visual, DefaultColormap(disp.disp, DefaultScreen(disp.disp)), @rBlack, @cBlack);
	
	XftDrawRect(draw, @cBlack, 0, 0, texW, texH);
	
	for i := 0 to High(ints.ints) do
	begin
		with ints.ints[i] do
		begin
			SetLength(syms, last - first + 1);
			FillChar(syms[0], SizeOf(syms), 0);
			
			for j := first to last do
			begin
				if not XftCharExists(disp.disp, font, j) then
				begin
					Continue;
				end;
				
				XftTextExtents16(disp.disp, font, @j, 1, @gi);
				
				if (x + gi.xOff + extraSpacingX) > texW then
				begin
					x := extraSpacingX;
					y += logHeight + extraSpacingY * 2;
				end;
				
				k := j - first;
				s := @syms[k];
				
				XftDrawString16(draw, @cWhite, font, x, y + font^.ascent, @j, 1);
				
				s^.advance := gi.xOff;// - gi.x;
				s^.a := 0;//Abs(gi.x);
				s^.c := 0;
				
				s^.x := -extraSpacingX;
				s^.y := -extraSpacingY;
				s^.w := s^.advance + extraSpacingX * 2;
				s^.h := logHeight + extraSpacingY * 2;

				s^.coords[0].x := (x + s^.x) / texW;
				s^.coords[0].y := (y + s^.y) / texH;
				s^.coords[1].x := (x + s^.x + s^.w) / texW;
				s^.coords[1].y := (y + s^.y + s^.h) / texH;

				x += s^.advance + extraSpacingX * 2;
			end;
		end;
	end;
	
	image := XGetImage(disp.disp, pixmap, 0, 0, texW, texH, AllPlanes, ZPixmap);
	
	for x := 0 to texW - 1 do
	begin
		for y := 0 to texH - 1 do
		begin
			color := image^.f.get_pixel(image, x, y);
			
			r := color and wnd.vi^.red_mask;
			g := color and wnd.vi^.green_mask;
			b := color and wnd.vi^.blue_mask;
			
			while r > $FF do r := r shr 8;
			while g > $FF do g := g shr 8;
			while b > $FF do b := b shr 8;
			
			data.data[x + y * texW] := (r + g + b) div 3;
		end;
	end;
	
	image^.f.destroy_image(image);
	
	XFreePixmap(disp.disp, pixmap);
	XftFontClose(disp.disp, font);
{$ENDIF}
	tex := TTexture.Create;
	tex.Upload(TEX_2D, @data, texFilter, TEX_REPEAT, False);

	height := height_;
	lineSkip := logHeight;
	spacing := 0;
	scale := 1;
	
	con.Msg('Шрифт "%s/%s %d" создан успешно', [faceWindows, faceLinux, height]);

	Result := True;
end;

function TFont.Save(fileName_: String): Boolean;
var
	f: File;
begin
	Result := False;

	(*if not tex.Save(fileName_) then
	begin
		//error
		Exit;
	end;

	{$I-}
	AssignFile(f, fileName_ + '.dat');
	Rewrite(f, 1);
	{$I+}

	if IOResult <> 0 then
	begin
		//error
		Exit;
	end;

	BlockWrite(f, syms[0], SizeOf(syms));
	BlockWrite(f, height, SizeOf(height));
	BlockWrite(f, logHeight, SizeOf(logHeight));
	BlockWrite(f, lineSkip, SizeOf(lineSkip));
	BlockWrite(f, spacing, SizeOf(spacing));
	BlockWrite(f, scale, SizeOf(scale));

	CloseFile(f);

	fileName := fileName_;

	Result := True;*)
end;

function TFont.Load(fileName_: String; texFilter: Integer = TEX_BI): Boolean;
var
	f: File;
begin
	Result := False;

	(*tex := TTexture.Create;

	if not tex.Load(fileName_, texFilter, TEX_REPEAT, False) then
	begin
		//error
		Exit;
	end;

	{$I-}
	AssignFile(f, fileName_ + '.dat');
	Reset(f, 1);
	{$I+}

	if IOResult <> 0 then
	begin
		//error
		Exit;
	end;

	BlockRead(f, syms[0], SizeOf(syms));
	BlockRead(f, height, SizeOf(height));
	BlockRead(f, logHeight, SizeOf(logHeight));
	BlockRead(f, lineSkip, SizeOf(lineSkip));
	BlockRead(f, spacing, SizeOf(spacing));
	BlockRead(f, scale, SizeOf(scale));

	CloseFile(f);

	fileName := fileName_;

	Result := True;*)
end;

procedure TFont.Render(text: String; x, y: Single; c: TVec4);
var
	i, j, k: Integer;
	s: PFontSym;
begin
	if (text = '') or (tex = nil) then
	begin
		Exit;
	end;

	glPushMatrix;
	glTranslatef(x, y, 0);
	glScalef(scale, scale, scale);

	tex.Enable;
	
	x := 0;
	y := 0;

	glColor4f(c.x, c.y, c.z, c.w);
	glBegin(GL_QUADS);
	
	i := 1;
	
	while i <= Length(text) do
	begin
		if text[i] = #13 then
		begin
			x := 0;
			y += lineSkip;
			i += 1;
			Continue;
		end;
		
		if Ord(text[i]) < 128 then
		begin
			j := Ord(text[i]);
			i += 1;
		end else
		
		if Ord(text[i]) < 224 then
		begin
			j := (Ord(text[i]) - 192) * 64 + Ord(text[i + 1]) - 128;
			i += 2;
		end else
		
		if Ord(text[i]) < 240 then
		begin
			j := (Ord(text[i]) - 224) * 4096 + (Ord(text[i + 1]) - 128) * 64 + Ord(text[i + 2]) - 128;
			i += 3;
		end else
		
		if Ord(text[i]) < 248 then
		begin
			j := (Ord(text[i]) - 240) * 262144 + (Ord(text[i + 1]) - 128) * 4096 + (Ord(text[i + 2]) - 128) * 64 + Ord(text[i + 3]) - 128;
			i += 4;
		end;
		
		s := nil;
		
		for k := 0 to High(ints.ints) do
		begin
			if (j >= ints.ints[k].first) and (j <= ints.ints[k].last) then
			begin
				s := @ints.ints[k].syms[j - ints.ints[k].first];
				Break;
			end;
		end;
		
		if s = nil then
		begin
			Continue;
		end;
		
		x -= s^.a;

		glMultiTexCoord2fARB(GL_TEXTURE0_ARB, s^.coords[0].x, s^.coords[0].y); glVertex2f(x + s^.x, y + s^.y);
		glMultiTexCoord2fARB(GL_TEXTURE0_ARB, s^.coords[0].x, s^.coords[1].y); glVertex2f(x + s^.x, y + s^.y + s^.h);
		glMultiTexCoord2fARB(GL_TEXTURE0_ARB, s^.coords[1].x, s^.coords[1].y); glVertex2f(x + s^.x + s^.w, y + s^.y + s^.h);
		glMultiTexCoord2fARB(GL_TEXTURE0_ARB, s^.coords[1].x, s^.coords[0].y); glVertex2f(x + s^.x + s^.w, y + s^.y);

		x += s^.advance - s^.c + spacing;
	end;

	glEnd;
	glPopMatrix;
end;

function TFont.Width(text: String): Single;
var
	i, j, k: Integer;
	s: PFontSym;
begin
	Result := 0;
	
	i := 1;
	
	while i <= Length(text) do
	begin
		if Ord(text[i]) < 128 then
		begin
			j := Ord(text[i]);
			i += 1;
		end else
		
		if Ord(text[i]) < 224 then
		begin
			j := (Ord(text[i]) - 192) * 64 + Ord(text[i + 1]) - 128;
			i += 2;
		end else
		
		if Ord(text[i]) < 240 then
		begin
			j := (Ord(text[i]) - 224) * 4096 + (Ord(text[i + 1]) - 128) * 64 + Ord(text[i + 2]) - 128;
			i += 3;
		end else
		
		if Ord(text[i]) < 248 then
		begin
			j := (Ord(text[i]) - 240) * 262144 + (Ord(text[i + 1]) - 128) * 4096 + (Ord(text[i + 2]) - 128) * 64 + Ord(text[i + 3]) - 128;
			i += 4;
		end;
		
		s := nil;
		
		for k := 0 to High(ints.ints) do
		begin
			if (j >= ints.ints[k].first) and (j <= ints.ints[k].last) then
			begin
				s := @ints.ints[k].syms[j - ints.ints[k].first];
				Break;
			end;
		end;
		
		if s = nil then
		begin
			Continue;
		end;
		
		Result := Result + s^.advance + s^.a + s^.c;
	end;

	Result := Result * scale;
end;

end.
